home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGASIC / SAYGET.LZH / SYGTDEMO.BAS < prev    next >
BASIC Source File  |  1987-06-15  |  13KB  |  245 lines
  1.  
  2. ' QBSAYGET.BAS: a Quick Basic subroutine   version 1
  3. ' adapted by  : Lee M. Bernbaum from the original SAYGET.BAS written for
  4. '             : Turbo Basic;also added TRIM subprogram at end
  5. '             : of listing.
  6. ' author .....: Vernon E. Davis  [71330,2705]
  7. ' purpose ....: emulates the dBASE @..SAY..GET..READ statement that
  8. '             : allows bullet-proof string input from the keyboard.
  9. ' syntax .....: Call SAYGET( row, colunm, saystring, getstring )   where
  10. '             :   row       = 1 to 25
  11. '             :   colunm    = 1 to 80
  12. '             :   saystring = string to SAY on the screen
  13. '             :   getstring = string to GET on the screen
  14. '             :   NOTE: the entire SAYGET combination MUST fit on one line
  15. ' returns ....: the data in getstring
  16. ' notes ......: there are four shared variables that MUST be declared.
  17. '             :   S.FORE% - the text color of the normal screen.
  18. '             :   S.BACK% - the background color of the normal screen.
  19. '             :   G.FORE% - the text color of the GET input line.
  20. '             :   G.BACK% - the background color of the GET input line.
  21. '             : the following editing keys are operational:
  22. '             :   RETURN - returns to calling routine with changes
  23. '             :   ESC - returns to calling routine without changes
  24. '             :   Left Arrow - moves one character left, non-destructive
  25. '             :   Right Arrow - moves one character right, non-destructive
  26. '             :   HOME - moves to beginning of GET line
  27. '             :   END - moves to end of GET line
  28. '             :   Backspace - moves one character left, destructive. If this
  29. '             :               key is used on the last character of the GET
  30. '             :               line, it will not erase it. Use the DEL key.
  31. '             :   DEL - deletes character from cursor position
  32. '             :   INS - toggles insert on and off. INS indicator appears
  33. '             :         at row 1, column 60 when insert is on
  34. '
  35. ' Turbo Basic is a product from Borland International
  36. ' Quick Basic is a product from Microsoft Corporation
  37. ' dBASE is a registered trademark of Ashton-Tate
  38. '
  39.  
  40. ' start delete here to remove demo...................................
  41. '
  42. ' ***  MAIN PROGRAM  ***
  43. '
  44. ' the main program is only a demo for the SAYGET subroutine. It is not
  45. ' required to use the SAYGET subroutine. clip it out with your editor before
  46. ' $INCLUDING this file in your programs.
  47. '
  48. S.FORE% = 7                                  ' color of normal text
  49. S.BACK% = 0                                  ' color of normal background
  50. G.FORE% = 0                                  ' color of GET text
  51. G.BACK% = 7                                  ' color of GET background
  52. Cls
  53. Locate 3,1
  54. Print "Test Program for SAYGET procedure.  Written by Vernon E. Davis"
  55. Print "TRIM written, and SAYGET adapted for Quick Basic by Lee M. Bernbaum"
  56. Locate 10,1
  57. Print "RETURN - returns to calling routine with changes"
  58. Print "ESC - returns to calling routine without changes"
  59. Print "Left Arrow - moves one character left, non-destructive"
  60. Print "Right Arrow - moves one character right, non-destructive"
  61. Print "HOME - moves to beginning of GET line"
  62. Print "END - moves to end of GET line"
  63. Print "Backspace - moves one character left, destructive. If this"
  64. Print "            key is used on the last character of the GET"
  65. Print "            line, it will not erase it. Use the DEL key."
  66. Print "DEL - deletes character from cursor position"
  67. Print "INS - toggles insert on and off. INS indicator appears"
  68. Print "      at row 1, column 60 when insert is on"
  69. saygetstr$ = "The SAYED string sent to SAYGET" ' initialize GET string
  70. first.len%=int(len(saygetstr$))
  71. Do
  72.  
  73.    Call SAYGET(6,1,"Enter any data or Q to quit-> ",saygetstr$,7,0,0,7)
  74.    trim$=saygetstr$:tlen%=0
  75.    Call TRIM(trim$,tlen%)
  76.    locate 7,1:print "The returned string SAYGET  = ";Chr$(34);saygetstr$;Chr$(34)
  77.    locate 8,1:print "The returned string TRIMMED = "+Chr$(34)+trim$+Chr$(34)+_
  78.           string$(len(saygetstr$)-tlen%,32)
  79.    if tlen%<>0 then
  80.       saygetstr$=left$(trim$+string$(first.len%," "),first.len%)
  81.    else
  82.        saygetstr$=string$(first.len%,42)
  83.    end if
  84. Loop Until tlen%=1 and trim$="q" OR trim$="Q"
  85. Cls
  86. End
  87. '
  88. 'stop deleting here when removing demo...............................
  89.  
  90. Sub SAYGET(ypos%,xpos%,saystr$,getstr$,S.FORE%,S.BACK%,G.FORE%,G.BACK%) static
  91.  
  92. '  Shared G.FORE%,G.BACK%,S.FORE%,S.BACK%
  93.  
  94.    inskey%=0                                       ' insert key initially off
  95.    gstrlen%=Len(getstr$)                           ' get GET string length
  96.    Locate ypos%,xpos%,1 : Print saystr$;           ' print SAY string
  97.    getbegin%=Pos(0)                                ' store beginning screen pos
  98.    getend%=(getbegin%+gstrlen%)-1                  ' store end screen pos
  99.    If getend% > 80 Then getend%=80                 ' insure string fits on line
  100.    Color G.FORE%,G.BACK%                           ' change to GET colors
  101.    Locate ypos%,getbegin%,1 : Print getstr$;       ' print GET string
  102.    Locate ypos%,getbegin%                          ' return cursor to beginning
  103.    Do                                              '
  104.       Do                                           '
  105.          ch$=Inkey$                                ' get character from kbd
  106.       Loop Until ch$ <> ""                         '
  107.                                                    ' check for these keys ...
  108.       IF ch$=Chr$(13) then                         ' ** RETURN Key **
  109.          getstr$=""                                '  clear GET string
  110.          For i%=getbegin% To getend%               '
  111.             h%=Screen(ypos%,i%)                    '  get char. from screen
  112.             getstr$=getstr$+Chr$(h%)               '  and place it in GET string
  113.          Next i%                                   '
  114.          Color S.FORE%,S.BACK%                     '  change normal color
  115.          Exit Sub                                  '  and return to caller
  116.  
  117.       ELSEIF ch$=Chr$(0)+Chr$(75) then             ' ** Left Arrow Key **
  118.          If Pos(0)=getbegin% Then                  '  if at the begin of line
  119.             Locate ypos%,getbegin%                 '   remain there
  120.          Else                                      '  else
  121.             Locate ypos%,Pos(0)-1                  '   move 1 char. left
  122.          End If                                    '
  123.  
  124.       ELSEIF ch$=Chr$(0)+Chr$(77) then             ' ** Right Arrow Key **
  125.          Locate ypos%,Pos(0)+1                     '  move 1 char. right
  126.          If Pos(0)>=getend% Then                   '  if at the end of line
  127.             Locate ypos%,getend%                   '   remain there
  128.          End If                                    '
  129.  
  130.       ELSEIF ch$=Chr$(0)+Chr$(71) then             ' ** Home Key **
  131.          Locate ypos%,getbegin%                    '  move to begin of line
  132.  
  133.       ELSEIF ch$=Chr$(0)+Chr$(79) then             ' ** End Key **
  134.          Locate ypos%,getend%                      '  move to end of line
  135.  
  136.       ELSEIF ch$=Chr$(0)+Chr$(83) then             ' ** Del Key **
  137.          j%=Pos(0)                                 '  store current horiz.
  138.          t0$=""                                    '  clear temp string
  139.          For i%=getbegin% To getend%               '
  140.             h%=Screen(ypos%,i%)                    '  get char. from screen
  141.             If Pos(0)<>i% Then                     '  if not equal to horiz.
  142.                t0$=t0$+Chr$(h%)                    '   place it in temp string
  143.             End If                                 '
  144.          Next i%                                   '
  145.          t0$=t0$+" "                               '   place blank at end
  146.          Locate ypos%,getbegin% : Print t0$;       '   replace string on screen
  147.          Locate ypos%,j%                           '   and return to horiz.
  148.  
  149.       ELSEIF ch$=Chr$(0)+Chr$(82) then             ' ** Ins Key **
  150.          If inskey%=0 Then                         '   if ins toggle off
  151.             inskey%=1                              '    turn ins toggle on
  152.             j%=Pos(0)                              '    store current horiz.
  153.             Color S.FORE%,S.BACK%                  '    normal colors
  154.             Locate 1,60,0 : Print "INS"            '    say that INS is on
  155.             Locate ypos%,j%,1                      '    return to horiz.
  156.             Color G.FORE%,G.BACK%                  '    and GET colors
  157.          Else                                      '   if ins toggle on
  158.             inskey%=0                              '    turn ins toggle off
  159.             j%=Pos(0)                              '    save current horiz.
  160.             Color S.FORE%,S.BACK%                  '    normal colors
  161.             Locate 1,60,0 : Print "   "            '    say that INS is off
  162.             Locate ypos%,j%,1                      '    return to horiz.
  163.             Color G.FORE%,G.BACK%                  '    and GET colors
  164.          End If                                    '
  165.       
  166.       ELSEIF ch$=Chr$(8) then                      ' ** Backspace Key **
  167.          If Pos(0)<>getbegin% Then                 '  if not at begin of line
  168.             Locate ypos%,Pos(0)-1                  '   move back one space
  169.             Print " ";                             '   print a space
  170.             Locate ypos%,Pos(0)-1                  '   and move back again
  171.          End If                                    '
  172.  
  173.       ELSEIF ch$=Chr$(27) then                     ' ** Escape Key **
  174.          Color S.FORE%,S.BACK%                     '  normal color
  175.          Exit Sub                                  '  return w/o modification
  176.  
  177.       ELSE
  178.          IF asc(ch$)>=32 and asc(ch$)<=126 then    ' ** Alphanumeric Keys **
  179.            If inskey%=1 Then                       '  if ins toggle on
  180.               j%=Pos(0)                            '   store current horiz.
  181.               t0$=""                               '   clear temp string
  182.           For i%=getbegin% To getend%-1        '
  183.             h%=Screen(ypos%,i%)            '   get char. from screen
  184.             If Pos(0)=i% Then              '   if horiz.
  185.                t0$=t0$+ch$                 '    add char. in temp string
  186.             End If                         '
  187.             t0$=t0$+Chr$(h%)               '    add screen chars.
  188.           Next i%                              '
  189.           if j%=getend% then t0$=left$(t0$,getend%-1)+ch$
  190.               Locate ypos%,getbegin% : Print t0$;  '   replace string on screen
  191.               if j%=getend% then                   '   and return to horiz.
  192.          locate ypos%,j%
  193.               else
  194.                  locate ypos%,j%+1
  195.               end if
  196.            Else                                    '  if ins toggle off
  197.               Print ch$;                           '   print char.
  198.               If Pos(0)>getend% Then               '   if at end of line
  199.                  Locate ypos%,getend%              '    remain at end of line
  200.               End If                               '
  201.            End If                                  '
  202.          ELSE
  203.             Locate ypos%,getend%                   '   remain there
  204.          END IF                                    '
  205.       END IF
  206.    Loop Until TRUE                                 ' loop always
  207. End Sub                                            ' >>>  End of SAYGET  <<<
  208. '
  209.  
  210. ' TRIM        : a Quick Basic subprogram   version 1
  211. ' author .....: Lee M. Bernbaum
  212. ' purpose ....: removes trailing blanks from a character string
  213. ' syntax .....: Call TRIM( trim$, tlen%)   where
  214. '             :   trim$ = the string to be trimmed
  215. '             :   tlen% = the length of the returned string
  216. ' returns ....: the string minus trailing blanks
  217.  
  218. sub TRIM(trim$,tlen%) static
  219.  
  220.     length%=len(trim$)
  221.  
  222.     if length%=0 or trim$=string$(length%," ") then
  223.        trim$=""
  224.        tlen%=0
  225.        exit sub
  226.     end if
  227.  
  228.     while length% > 0
  229.  
  230.        chk$ = mid$(trim$,length%,1)                     'start at end of string
  231.  
  232.        if chk$ = chr$(0) or chk$=chr$(255) or chk$=" " then
  233.           length% = length%-1                           'blank - keep checking
  234.        else
  235.           trim$ = left$(trim$,length%)                  'terminate at first
  236.           tlen% = length%                               'non-blank character
  237.           exit sub  
  238.        end if
  239.  
  240.     wend
  241.  
  242. end sub
  243.  
  244.  
  245.